home *** CD-ROM | disk | FTP | other *** search
/ Tech Arsenal 1 / Tech Arsenal (Arsenal Computer).ISO / tek-04 / bipl.zip / PROGS.ZIP / PUZZ.ICN < prev    next >
Text File  |  1992-09-28  |  4KB  |  140 lines
  1. ############################################################################
  2. #
  3. #    File:     puzz.icn
  4. #
  5. #    Subject:  Program to create word search puzzle
  6. #
  7. #    Author:   Chris Tenaglia
  8. #
  9. #    Date:     Februrary 21, 1992
  10. #
  11. ###########################################################################
  12.  
  13. global matrix,      # the actual puzzle board
  14.        width,       # width of the puzzle
  15.        height,      # height of the puzzle
  16.        completed    # number of completed word placements
  17.  
  18. procedure main(param)
  19.   local i, j, line, pass, tokens, word, words
  20.  
  21. #
  22. # initial set up : x=20, y=20 by default
  23. #
  24.   width  := param[1] | 20
  25.   height := param[2] | 20
  26.   words  := []
  27. #
  28. # load words to place in a space delimited
  29. # file. more than one word per line is ok.
  30. #
  31.   while line := map(read()) do
  32.     {
  33.     tokens := parse(line,' \t')
  34.     while put(words,pop(tokens))
  35.     }
  36. #
  37. # get ready for main processing
  38. #
  39.   matrix    := table(" ")
  40.   pass      := 0
  41.   completed := 0
  42.   &random:= map(&clock,":","0")
  43. #
  44. # here's the actual word placement rouinte
  45. #
  46.   every word := !words do place(word)
  47. #
  48. # fill in the unchosen areas with random alphas
  49. #
  50.   every i := 1 to height do
  51.     every j := 1 to width do
  52.       if matrix[i||","||j] == " " then
  53.          matrix[i||","||j] := ?(&ucase)
  54. #
  55. # output results (for the test giver, words are lcase, noise is ucase)
  56. #
  57.   write(completed," words inserted out of ",*words," words.\n")
  58.   write("\nNow for the puzzle you've been waiting for! (ANSWER)\n")
  59.   every i := 1 to height do
  60.     {
  61.     every j := 1 to width do writes(matrix[i||","||j]," ")
  62.     write()
  63.     }
  64. #
  65. # output results (for the test taker, everything is upper case
  66. #
  67.   write("\fNow for the puzzle you've been waiting for! (PUZZLE)\n")
  68.   every i := 1 to height do
  69.     {
  70.     every j := 1 to width do writes(map(matrix[i||","||j],&lcase,&ucase)," ")
  71.     write()
  72.     }
  73.   end
  74.  
  75. #
  76. # this procedure tries to place the word in a copy of the matrix
  77. # if successful the updated copy is moved into the original
  78. # if not, the problem word is skipped after 20 tries
  79. #
  80. procedure place(str)
  81.   local byte, construct, direction, item, pass, x, xinc, y, yinc
  82.   static xstep,ystep
  83.  
  84.   initial {
  85.           xstep := [0,1,1,1,0,-1,-1,-1]
  86.           ystep := [-1,-1,0,1,1,1,0,-1]
  87.           }
  88.   pass := 0
  89.  
  90.   repeat  {
  91.   if (pass +:= 1) > 20 then
  92.     { 
  93.     write("skipping ",str)
  94.     fail
  95.     }
  96.   direction := ?8
  97.   xinc      := integer(xstep[direction])
  98.   yinc      := integer(ystep[direction])
  99.  
  100.   if xinc < 0 then x := *str + ?(width - *str)
  101.   if xinc = 0 then x := ?height
  102.   if xinc > 0 then x := ?(width - *str)
  103.  
  104.   if yinc < 0 then y := *str + ?(height - *str)
  105.   if yinc = 0 then y := ?width
  106.   if yinc > 0 then y := ?(height - *str)
  107.  
  108.   if (x < 1) | (y < 1) then stop(str," too long.")
  109.  
  110.   construct := copy(matrix)
  111.   item      := str
  112.   write("placing ",item)
  113.   every byte := !item do
  114.     {
  115.     if (construct[x||","||y] ~== " ")  &
  116.        (construct[x||","||y] ~== byte) then break next
  117.     construct[x||","||y] := byte
  118.     x +:= xinc
  119.     y +:= yinc
  120.     }
  121.   matrix     := copy(construct)
  122.   completed +:= 1
  123.   return "ok"
  124.   } # end repeat
  125.   return "ok"
  126.   end
  127.  
  128. #
  129. # parse a string into a list with respect to a delimiter (cset)
  130. #
  131. procedure parse(line,delims)  
  132.   local tokens
  133.   static chars
  134.  
  135.   chars  := &cset -- delims
  136.   tokens := []
  137.   line ? while tab(upto(chars)) do put(tokens,tab(many(chars)))
  138.   return tokens
  139.   end
  140.